{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Screen;

interface

uses Classes, Windows, Forms, AHMTypes, Canvas, Viewport, ScreenForm;

const
  REQUIRED_SCREEN_DEPTH = 32;
  DEFAULT_VIRTUAL_WIDTH = 800;
  DEFAULT_VIRTUAL_HEIGHT = 600;
  DEFAULT_PHYSICAL_WIDTH = 800;
  DEFAULT_PHYSICAL_HEIGHT = 600;
  DEFAULT_SCREEN_XOFFSET = 0;
  DEFAULT_SCREEN_YOFFSET = 0;
  DEFAULT_SCREEN_XSCALE = 1;
  DEFAULT_SCREEN_YSCALE = 1;
  INTERNAL_SCREEN_WIDTH = 1;
  INTERNAL_SCREEN_HEIGHT = 1;
  SCREEN_CENTRE = 0.5;
  CLICK_RADIUS = 0.005;
  ZOOM_FACTOR = 1.10;

type
  TAHMDisplayMode = class
  private
    FWidth: Integer;
    FHeight: Integer;
    FDepth: Integer;
  protected
    function GetAsString: String;
  public
    property Width: Integer read FWidth write FWidth;
    property Height: Integer read FHeight write FHeight;
    property Depth: Integer read FDepth write FDepth;
    property AsString: String read GetAsString;
    constructor Create(Width, Height, Depth: Integer);
  end;

  TAHMDisplayModes = class(TList)
  private
  protected
  public
    destructor Destroy; override;
    procedure AddDisplayMode(Width, Height, Depth: Integer);
    procedure ClearDisplayModes;
    function IsModeSupported(Width, Height, Depth: Integer): Boolean;
    function GetDisplayMode(Index: Integer): TAHMDisplayMode;
    function GetSupportedMode(Width, Height, Depth: Integer): TAHMDisplayMode;
  end;

  TAHMScreen = class
  private
    FVirtualWidth: Integer;
    FVirtualHeight: Integer;
    FDesignerWidth: Integer;
    FDesignerHeight: Integer;
    FAspectRatio: Single;
    FClickRadius: Single;
    FPhysicalWidth: Integer;
    FPhysicalHeight: Integer;
    FScreenXOffset: Single;
    FScreenYOffset: Single;
    FScreenXScale: Single;
    FScreenYScale: Single;
    FScreenForm: TAHMScreenForm;
    FScreenHandle: HWND;
    FDrawingBuffer: TAHMDrawBuffer;
    FDisplayModes: TAHMDisplayModes;
    FTextureFormat: TAHMTextureFormat;
    FViewport: TAHMViewport;
    FFullScreen: Boolean;
    FMouseX, FMouseY: Single;
    FDisplayAdapter: Integer;
  protected
    procedure SetScreenHandle(ScreenHandle: HWND);
    procedure SetScreenXOffset(XOffset: Single);
    procedure SetScreenYOffset(YOffset: Single);
    procedure SetScreenXScale(XScale: Single);
    procedure SetScreenYScale(YScale: Single);
    function GetWideScreen: Boolean;
    procedure SetMouseVisible(Visible: Boolean);
    function GetMouseVisible: Boolean;
    function GetScreenRect: TAHMRectF;
    function GetDrawingCanvas: TAHMCanvas;
  public
    constructor Create;
    destructor Destroy; override;
    property ScreenForm: TAHMScreenForm read FScreenForm write FScreenForm;
    property ScreenHandle: HWND read FScreenHandle write SetScreenHandle;
    property Viewport: TAHMViewport read FViewport;
    property VirtualWidth: Integer read FVirtualWidth write FVirtualWidth;
    property VirtualHeight: Integer read FVirtualHeight write FVirtualHeight;
    property DesignerWidth: Integer read FDesignerWidth write FDesignerWidth;
    property DesignerHeight: Integer read FDesignerHeight write FDesignerHeight;
    property AspectRatio: Single read FAspectRatio;
    property ClickRadius: Single read FClickRadius;
    property PhysicalWidth: Integer read FPhysicalWidth;
    property PhysicalHeight: Integer read FPhysicalHeight;
    property ScreenXOffset: Single read FScreenXOffset write SetScreenXOffset;
    property ScreenYOffset: Single read FScreenYOffset write SetScreenYOffset;
    property ScreenXScale: Single read FScreenXScale write SetScreenXScale;
    property ScreenYScale: Single read FScreenYScale write SetScreenYScale;
    property FullScreen: Boolean read FFullScreen write FFullScreen;
    property WideScreen: Boolean read GetWideScreen;
    property DisplayAdapter: Integer read FDisplayAdapter write FDisplayAdapter;
    property ScreenRect: TAHMRectF read GetScreenRect;
    property DrawingBuffer: TAHMDrawBuffer read FDrawingBuffer;
    property DrawingCanvas: TAHMCanvas read GetDrawingCanvas;
    property DisplayModes: TAHMDisplayModes read FDisplayModes;
    property TextureFormat: TAHMTextureFormat read FTextureFormat write FTextureFormat;
    property MouseVisible: Boolean read GetMouseVisible write SetMouseVisible;
    property MouseX: Single read FMouseX;
    property MouseY: Single read FMouseY;
    procedure Initialise;
    procedure ResetDisplay;
    procedure DisplayScreen;
    procedure ShutDown;
    procedure Halt;
    function BeginDrawing: Boolean;
    procedure EndDrawing;
    procedure UpdateDisplay;
    procedure BringToFront;
    procedure SetPhysicalSize(Width, Height: Integer);
    procedure ZoomIn;
    procedure ZoomOut;
    procedure ZoomReset;
    procedure PanZoom(DX, DY: Single);
    function ScaleVirtualX(const XPos: Integer): Single;
    function ScaleVirtualY(const YPos: Integer): Single;
    function ScaleVirtualValue(const Value: Integer): Single;
    function ScalePhysicalX(const XPos: Single): Integer;
    function ScalePhysicalY(const YPos: Single): Integer;
    function ScaleClientX(const XPos: Integer): Single; overload;
    function ScaleClientX(const XPos, Width: Integer): Single; overload;
    function ScaleClientY(const YPos: Integer): Single; overload;
    function ScaleClientY(const YPos, Height: Integer): Single; overload;
    function ScaleMouseX(const XPos: Integer): Single;
    function ScaleMouseY(const YPos: Integer): Single;
  end;

var
  ScreenInstance: TAHMScreen;

implementation

uses SysUtils, Types, Controls, ApplicationManager, DirectXHelper,
     DirectShowManager, Logging;

//----------------------------------------------------------------------------//

constructor TAHMDisplayMode.Create(Width, Height, Depth: Integer);
begin
  inherited Create;

  FWidth := Width;
  FHeight := Height;
  FDepth := Depth;
end;

function TAHMDisplayMode.GetAsString: String;
begin
  Result := IntToStr(FWidth) + ' x ' + IntToStr(FHeight);
end;


//----------------------------------------------------------------------------//

destructor TAHMDisplayModes.Destroy;
var
  i: Integer;
begin
  // Release all stored display mode objects
  for i := 0 to Pred(Count) do
    TAHMDisplayMode(Items[i]).Free;

  inherited Destroy;
end;

procedure TAHMDisplayModes.AddDisplayMode(Width, Height, Depth: Integer);
var
  mode: TAHMDisplayMode;
begin
  // Create new display mode object instance unless we already have stored
  if IsModeSupported(Width, Height, Depth) then Exit;

  if LogDebugEnabled then
    LogDebug('Found compatible display mode: ' + IntToStr(Width) + 'x' +
             IntToStr(Height) + 'x' + IntToStr(Depth) + ' bits');
  mode := TAHMDisplayMode.Create(Width, Height, Depth);
  Add(mode);
end;

procedure TAHMDisplayModes.ClearDisplayModes;
var
  i: Integer;
begin
  // Release all stored display mode objects
  for i := 0 to Pred(Count) do
    TAHMDisplayMode(Items[i]).Free;

  // Clear all object pointers
  Clear;
end;

function TAHMDisplayModes.IsModeSupported(Width, Height, Depth: Integer): Boolean;
begin
  // Defer to method below
  Result := (GetSupportedMode(Width, Height, Depth) <> nil);
end;

function TAHMDisplayModes.GetDisplayMode(Index: Integer): TAHMDisplayMode;
begin
  if (Index >= 0) and (Index < Count) then
    Result := TAHMDisplayMode(Items[Index])
  else
    Result := nil;
end;

function TAHMDisplayModes.GetSupportedMode(Width, Height, Depth: Integer): TAHMDisplayMode;
var
  i: Integer;
  mode: TAHMDisplayMode;
begin
  // Iterate through all supported display modes
  for i := 0 to Pred(Count) do
  begin
    mode := TAHMDisplayMode(Items[i]);
    if (mode.Width = Width) and (mode.Height = Height) and (mode.Depth = Depth) then
    begin
      Result := mode;
      Exit;
    end;
  end;

  // No matching mode found
  Result := nil;
end;


//----------------------------------------------------------------------------//

constructor TAHMScreen.Create();
begin
  inherited Create;

  // Set screen properties
  FVirtualWidth := DEFAULT_VIRTUAL_WIDTH;
  FVirtualHeight := DEFAULT_VIRTUAL_HEIGHT;
  FPhysicalWidth := DEFAULT_PHYSICAL_WIDTH;
  FPhysicalHeight := DEFAULT_PHYSICAL_HEIGHT;
  FAspectRatio := FPhysicalWidth / FPhysicalHeight;

  // Reset full screen display
  ZoomReset;

  FDisplayModes := TAHMDisplayModes.Create;
end;

destructor TAHMScreen.Destroy;
begin
  // Free our persistent objects
  FViewport.Free;
  FDrawingBuffer.Free;
  FDisplayModes.Free;

  inherited Destroy;
end;

procedure TAHMScreen.SetScreenHandle(ScreenHandle: HWND);
begin
  // Update screen handle for DirectX rendering
  FScreenHandle := ScreenHandle;
  DirectXInstance.RenderHandle := FScreenHandle;
end;

procedure TAHMScreen.Initialise;
begin
  // Create instance of main screen form if required
  if not (ApplicationManagerInstance.DesignerMode or Assigned(FScreenForm)) then
    FScreenForm := TAHMScreenForm.Create(nil);

  // Construct screen drawing buffer to expose externally
  if not Assigned(FDrawingBuffer) then
    FDrawingBuffer := TAHMDrawBuffer.Create;

  // Create viewport
  if not Assigned(FViewport) then
  begin
    FViewport := TAHMViewport.Create;
    FViewport.Width := INTERNAL_SCREEN_WIDTH;
    FViewport.Height := INTERNAL_SCREEN_HEIGHT;
  end;
end;

procedure TAHMScreen.ResetDisplay;
begin
  // Update focus handle for DirectX (shouldn't change)
  if Assigned(FScreenForm) and FFullScreen then
    DirectXInstance.FocusHandle := FScreenForm.Handle
  else
    DirectXInstance.FocusHandle := Application.Handle;

  // Reset DirectX display device
  DirectXInstance.ResetRequired;
end;

procedure TAHMScreen.DisplayScreen;
begin
  // Configure and initialise DirectX surfaces
  DirectXInstance.DisplayAdapter := FDisplayAdapter;
  DirectXInstance.FullScreen := FFullScreen;

  // Assign rendering target for DirectX
  if Assigned(FScreenForm) then
  begin
    DirectXInstance.RenderForm := FScreenForm;
    FScreenHandle := FScreenForm.Handle;
  end
  else
    DirectXInstance.RenderHandle := FScreenHandle;

  // Set default focus handle for DirectX, may override this later
  DirectXInstance.FocusHandle := Application.Handle;

  if not DirectXInstance.Initialise then
    LogError('Problem initialising DirectX!')
  else
  begin
    // Ensure mediate is visible
    BringToFront;
  end;
end;

procedure TAHMScreen.ShutDown;
begin
  // Suspend rendering first so no more paint events fire
  ApplicationManagerInstance.SuspendRendering;

  // Close down our DirectX objects
  DirectXInstance.ShutDown;

  // Release our drawing buffer & viewport
  FreeAndNil(FDrawingBuffer);
  FreeAndNil(FViewport);

  // Tell our screen form to close
  if Assigned(FScreenForm) then FScreenForm.Hide;

  // Cleardown supported screen modes
  FDisplayModes.ClearDisplayModes;
end;

procedure TAHMScreen.Halt;
begin
  // Suspend GUI rendering to allow user to see message
  try
    DirectXInstance.ShutDown;
    if Assigned(FScreenForm) then FScreenForm.Hide;
  except
    // Don't allow any exceptions to recurse
  end;
end;

function TAHMScreen.BeginDrawing: Boolean;
begin
  // Initiate DirectX drawing
  Result := DirectXInstance.BeginDrawing;

  if Result then
  begin
    // Reset rotation prior to rendering UI
    FViewport.Canvas.UnlockRotation;
    FViewport.Canvas.UnSetRotation;
  end;
end;

procedure TAHMScreen.EndDrawing;
begin
  // Complete DirectX drawing tasks
  DirectXInstance.EndDrawing;
end;

procedure TAHMScreen.UpdateDisplay;
begin
  // Present updated drawing to display
  DirectXInstance.UpdateDisplay;
end;

procedure TAHMScreen.BringToFront;
begin
  // Empty message queue first
  Application.ProcessMessages;
  
  // If screen form is created but not visible then show it
  if Assigned(FScreenForm) and not FScreenForm.Visible then FScreenForm.Show;

  // Restore the mediate application if it's minimised
  if not Application.Active then Application.Restore;

  // Restore our render form if it's minimised
  if Assigned(FScreenForm) and (FScreenForm.WindowState = wsMinimized) then FScreenForm.WindowState := wsNormal;

  // Bring mediate to the front of the desktop
  Application.BringToFront;

  // Now try to make the render form active
  if Assigned(FScreenForm) then FScreenForm.SetFocus;
end;

function TAHMScreen.GetDrawingCanvas: TAHMCanvas;
begin
  Result := FDrawingBuffer.Canvas;
end;

procedure TAHMScreen.SetPhysicalSize(Width, Height: Integer);
begin
  // Cache new physical size
  FPhysicalWidth := Width;
  FPhysicalHeight := Height;

  // Adjust size of internal draw buffer and screen form
  if Assigned(FScreenForm) then
    FScreenForm.SetSize(FPhysicalWidth, FPhysicalHeight);

  FDrawingBuffer.Width := FPhysicalWidth;
  FDrawingBuffer.Height := FPhysicalHeight;

  // Update aspect ratio and radius for control clicks
  if FPhysicalHeight <> 0 then
    FAspectRatio := FPhysicalWidth / FPhysicalHeight
  else
    FAspectRatio := DEFAULT_VIRTUAL_WIDTH / DEFAULT_VIRTUAL_HEIGHT;
  FClickRadius := CLICK_RADIUS;

  // Set display mode size for Direct X helper
  DirectXInstance.SetDisplayResolution(FPhysicalWidth, FPhysicalHeight);
end;

procedure TAHMScreen.SetScreenXOffset(XOffset: Single);
begin
  // Validate horizontal offset within sensible range
  if XOffset > 0.5 then FScreenXOffset := 0.5
  else if XOffset < -0.5 then FScreenXOffset := -0.5
  else FScreenXOffset := XOffset;
end;

procedure TAHMScreen.SetScreenYOffset(YOffset: Single);
begin
  // Validate vertical offset within sensible range
  if YOffset > 0.5 then FScreenYOffset := 0.5
  else if YOffset < -0.5 then FScreenYOffset := -0.5
  else FScreenYOffset := YOffset;
end;

procedure TAHMScreen.SetScreenXScale(XScale: Single);
begin
  // Validate horizontal scale within sensible range
  if XScale > 2.0 then FScreenXScale := 2.0
  else if XScale < 0.5 then FScreenXScale := 0.5
  else FScreenXScale := XScale;
end;

procedure TAHMScreen.SetScreenYScale(YScale: Single);
begin
  // Validate vertical scale within sensible range
  if YScale > 2.0 then FScreenYScale := 2.0
  else if YScale < 0.5 then FScreenYScale := 0.5
  else FScreenYScale := YScale;
end;

function TAHMScreen.GetWideScreen: Boolean;
begin
  // Widescreen is considered to be anything with an aspect ratio < 0.7
  Result := FPhysicalHeight < (FPhysicalWidth * 0.7);
end;

procedure TAHMScreen.SetMouseVisible(Visible: Boolean);
begin
  // Only support mouse cursor control when running through render form
  if not Assigned(FScreenForm) then Exit;

  if Visible then FScreenForm.Cursor := crDefault
             else FScreenForm.Cursor := crNone;
end;

function TAHMScreen.GetMouseVisible: Boolean;
begin
  Result := Assigned(FScreenForm) and (FScreenForm.Cursor = crDefault);
end;

function TAHMScreen.GetScreenRect: TAHMRectF;
begin
  // Create a full screen rectangle
  Result := MakeRectF(0, 0, INTERNAL_SCREEN_WIDTH, INTERNAL_SCREEN_HEIGHT);
end;

procedure TAHMScreen.ZoomReset;
begin
  // Set default display offset & size (fullscreen)
  FScreenXOffset := DEFAULT_SCREEN_XOFFSET;
  FScreenYOffset := DEFAULT_SCREEN_YOFFSET;
  FScreenXScale := DEFAULT_SCREEN_XSCALE;
  FScreenYScale := DEFAULT_SCREEN_YSCALE;
end;

procedure TAHMScreen.ZoomIn;
begin
  SetScreenXScale(FScreenXScale * ZOOM_FACTOR);
  SetScreenYScale(FScreenYScale * ZOOM_FACTOR);
end;

procedure TAHMScreen.ZoomOut;
begin
  SetScreenXScale(FScreenXScale / ZOOM_FACTOR);
  SetScreenYScale(FScreenYScale / ZOOM_FACTOR);
end;

procedure TAHMScreen.PanZoom(DX, DY: Single);
begin
  SetScreenXOffset(FScreenXOffset + DX);
  SetScreenYOffset(FScreenYOffset + DY);
end;

function TAHMScreen.ScaleVirtualX(const XPos: Integer): Single;
begin
  Result := XPos / FVirtualWidth;
end;

function TAHMScreen.ScaleVirtualY(const YPos: Integer): Single;
begin
  Result := YPos / FVirtualHeight;
end;

function TAHMScreen.ScaleVirtualValue(const Value: Integer): Single;
begin
  // Average vertical and horizontal dimensions to compensate for aspect ratio
  Result := Value * (FPhysicalWidth + FPhysicalHeight) / FVirtualWidth / 2;
end;

function TAHMScreen.ScalePhysicalX(const XPos: Single): Integer;
begin
  Result := Round(XPos * FVirtualWidth);
end;

function TAHMScreen.ScalePhysicalY(const YPos: Single): Integer;
begin
  Result := Round(YPos * FVirtualHeight);
end;

function TAHMScreen.ScaleClientX(const XPos: Integer): Single;
begin
  // Scale screen form coordinates if it is stretched in windowed mode
  if not Assigned(FScreenForm) then
    Result := ScaleClientX(XPos, FDesignerWidth)
  else if FFullscreen then
    Result := ScaleClientX(XPos, 0)
  else
    Result := ScaleClientX(XPos, FScreenForm.ClientWidth);
end;

function TAHMScreen.ScaleClientX(const XPos, Width: Integer): Single;
begin
  // First compensate mouse coordinate for stretched render window
  if Width > 0 then Result := XPos / Width else Result := XPos / FPhysicalWidth;

  // Normalise mouse origin to centre of screen, scale then offset origin again
  Result := ((Result - SCREEN_CENTRE) / FScreenXScale) + SCREEN_CENTRE;

  // Finally we need to adjust for screen offset
  Result := Result - FScreenXOffset;
end;

function TAHMScreen.ScaleClientY(const YPos: Integer): Single;
begin
  // Scale screen form coordinates if it is stretched in windowed mode
  if not Assigned(FScreenForm) then
    Result := ScaleClientY(YPos, FDesignerHeight)
  else if FFullscreen then
    Result := ScaleClientY(YPos, 0)
  else
    Result := ScaleClientY(YPos, FScreenForm.ClientHeight);
end;

function TAHMScreen.ScaleClientY(const YPos, Height: Integer): Single;
begin
  // First compensate mouse coordinate for stretched render window
  if Height > 0 then Result := YPos / Height else Result := YPos / FPhysicalHeight;

  // Normalise mouse origin to centre of screen, scale then offset origin again
  Result := ((Result - SCREEN_CENTRE) / FScreenYScale) + SCREEN_CENTRE;

  // Finally we need to adjust for screen offset
  Result := Result - FScreenYOffset;
end;

function TAHMScreen.ScaleMouseX(const XPos: Integer): Single;
begin
  // Convert and cache mouse X coordinate
  FMouseX := ScaleClientX(XPos);
  Result := FMouseX;
end;

function TAHMScreen.ScaleMouseY(const YPos: Integer): Single;
begin
  // Convert and cache mouse Y coordinate
  FMouseY := ScaleClientY(YPos);
  Result := FMouseY;
end;

initialization
  ScreenInstance := TAHMScreen.Create;
  DirectXInstance := TAHMDirectXHelper.Create;
  DirectShowInstance := TAHMDirectShowManager.Create;

finalization
  DirectShowInstance.Free;
  DirectXInstance.Free;
  ScreenInstance.Free;

end.


